Introducción

Se determina el modelo de servicios diarios entre el períodode 2019 hasta julio de 2024 con frecuencia diaria.

ruta_servicios <- "/cloud/project/df_serv_dif.xlsx"
excel_sheets(ruta_servicios)
## [1] "Sheet1"
servicios <- as.data.frame(read_xlsx(ruta_servicios, 
                                     sheet = "Sheet1", col_names = T))
## New names:
## • `` -> `...1`
colnames(servicios) <- c("","Indice", "Fecha", "Totales")
servicios <- select(servicios, c("Indice", "Fecha", "Totales"))
nrow(servicios)
## [1] 183
head(servicios)
##   Indice      Fecha    Totales
## 1      1 2019-07-03 -1.0949284
## 2      2 2019-07-11 -2.4210608
## 3      3 2019-07-20  2.0561828
## 4      4 2019-07-22  0.4443343
## 5      5 2019-07-31  1.3214042
## 6      6 2019-08-05 -3.9744676

Serie temporal

servicios_diarios_ts <- ts(
  data = servicios$Totales,
  start = c(2019,07,03), frequency = 365)
servicios_diarios_xts <- xts(servicios$Totales, 
                             order.by = servicios$Fecha, frequency = 365)

Visualizacion de la serie.

ts_plot(servicios_diarios_ts, color = "darkgreen", Xtitle = "Fecha", 
        Ytitle = "Valores", 
        title = "Serie de servicios diarios")
plot.xts(x = servicios_diarios_xts, bg = "white", 
              col = "black", labels.col = "black", 
         main = "Serie de servicios diarios")

Determinación de estacionalidad.

urca::ur.df(servicios_diarios_ts)
## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -12.3695

El valor del estadístico de Dickey-Fuller es -12.3695. Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.

kpss.test(servicios_diarios_ts)
## Warning in kpss.test(servicios_diarios_ts): p-value greater than printed
## p-value
## 
##  KPSS Test for Level Stationarity
## 
## data:  servicios_diarios_ts
## KPSS Level = 0.055123, Truncation lag parameter = 4, p-value = 0.1

KPSS Level = 0.055123, Truncation lag parameter = 4, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.

Determinación de ACF y PACF.

ggAcf(servicios_diarios_ts, col = "red", lwd = 1)# p = 1

ggPacf(servicios_diarios_ts, col = "blue", lag.max = 10, lwd = 1) # q = 1

División de la serie en entrenamiento y prueba.

div_dia_serv <- ts_split(servicios_diarios_ts, 
                                 sample.out =
                           round(length(servicios_diarios_ts)*0.2))

entrena_serv_diaria <- div_dia_serv$train

prueba_serv_diaria <- div_dia_serv$test

Modelo

modelo_arima_dia_serv <- auto.arima(entrena_serv_diaria, 
                                       seasonal = F,
                                       stepwise = F, 
                                    stationary = T)
summary(modelo_arima_dia_serv)
## Series: entrena_serv_diaria 
## ARIMA(0,0,1) with zero mean 
## 
## Coefficients:
##           ma1
##       -0.3123
## s.e.   0.0798
## 
## sigma^2 = 6.185:  log likelihood = -339.73
## AIC=683.46   AICc=683.55   BIC=689.43
## 
## Training set error measures:
##                      ME     RMSE      MAE MPE MAPE MASE         ACF1
## Training set 0.07023638 2.478448 1.890346 NaN  Inf  NaN -0.001958825
# AIC=683.46   AICc=683.55   BIC=689.43
# ARIMA(0,0,1) with zero mean 

Residuales

checkresiduals(modelo_arima_dia_serv, col = "red")# p-value = 0.608

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(0,0,1) with zero mean
## Q* = 25.363, df = 28, p-value = 0.608
## 
## Model df: 1.   Total lags used: 29

Pronóstico

pronostico_diaria_serv <- forecast(modelo_arima_dia_serv, 
                                   h = length(prueba_serv_diaria), 
                                   level = 0.95)

Gráficas de pronósticos

Medidas de exactitud.

accuracy(pronostico_diaria_serv$mean, prueba_serv_diaria)
##                  ME     RMSE      MAE      MPE     MAPE       ACF1 Theil's U
## Test set -0.1746723 2.580305 1.923801 98.96327 98.96327 -0.3545646         0
#                  ME     RMSE      MAE      MPE     MAPE       
# Test set -0.1746723 2.580305 1.923801 98.96327 98.96327       

Medidas de exactitud a 50 días

accuracy(pronostico_diaria_serv$mean[1:50], prueba_serv_diaria[1:50])
##                  ME     RMSE      MAE      MPE     MAPE
## Test set -0.1746723 2.580305 1.923801 98.96327 98.96327
#                  ME     RMSE      MAE      MPE     MAPE       
# Test set -0.1746723 2.580305 1.923801 98.96327 98.96327       

Conclusiones

El modelo determinado está muy debajo del mejor modelo (RML) por lo cual no se considera un modelo óptimo.